Delphi 2 - Developers' Solutions/Delphi 2 Developers' Solutions.iso/dds/chap06/howto03/dibfiles.pas

Pascal/Delphi Source File | 1996-01-04 | 18.0 KB | 488 lines

{==========================================================================}
{                       UNIT --> DIBFILES <--                              }
{                                                                          }
{ This unit is designed to handle the loading and drawing of device-       }
{ independent bitmap files in Windows 3.0. (FBMPMGR handles the interface  }
{ to hyperspace applications.)  This unit does the grunt work, via the     }
{ File_Bitmap object.                                                      }
{==========================================================================}

unit dibfiles;

{**************************************************************************}
{                                                                          }
{                            INTERFACE SECTION                             }
{                                                                          }
{**************************************************************************}

interface

{**************************************************************************}
{                                                                          }
{                                USES SECTION                              }
{                                                                          }
{**************************************************************************}

uses

Strings,             { Windows 3.x Strings Unit                         }
WinAPI,              { Windows 3.x API Unit                             }
WinCrt,              { Windows 3.x Crt Unit                             }
WinPrn,              { Windows 3.x Printer Unit                         }
WinProcs,            { Windows 3.x Standard Procedures Unit             }
WinTypes,            { Windows 3.x Types Unit                           }
OWindows,            { Windows 3.x Windows Unit                         }
ODialogs,            { Windows 3.x Dialogs Unit                         }
OMemory,             { Windows 3.x Memory Management Unit               }
Objects,             { Windows 3.x Object Management Unit               }
OPrinter,            { Windows 3.x Printer Management Unit              }
OStdDlgs,            { Windows 3.x Standard Dialog Unit                 }
OStdWnds,            { Windows 3.x Standard Windows Unit                }
Validate;            { Windows 3.x Validation Unit                      }

{**************************************************************************}
{                                                                          }
{                              TYPES SECTION                               }
{                                                                          }
{**************************************************************************}

type

{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ FILE_BITMAP Object                                                       }
{                                                                          }
{ This object handles the loading and drawing of DIB files in Windows 3.0  }
{ If a file cannot be found or is not a 3.0 DIB error codes are returned.  }
{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

PFile_Bitmap = ^File_Bitmap;
File_BitMap = object( TObject )

Bitmap_Handle    : HBitmap;   { Holds the DIB when done               }
Width            : Longint;   { Holds the pixel width when done       }
Height           : Longint;   { Holds the pixel height when done      }
The_File         : File;      { File variable for internal use        }
The_Name         : PChar;     { Holds the file name                   }
Bits_Handle      : THandle;   { temporary holder for the DIB          }
Bits_Byte_Size   : Longint;   { temporary holder for the              }
                              { byte length of the DIB                }
Error_Status     : Integer;   { code for error condition on the DIB   }

constructor INIT( The_DIB_Name : PChar );
destructor DONE; virtual;
procedure GET_BITMAP_DATA;
function GET_BITMAP : HBitmap;
function GET_BITMAP_NAME : PChar;
function LOAD_BITMAP_FILE : Boolean;
function OPEN_DIB : Boolean;
function GET_ERROR_STATUS : Integer;
function GET_FILE_NAME : PChar;
procedure DRAW( The_DC       : HDC;
                X_Location ,
                Y_Location   : Integer );
procedure DRAW_RESIZED( The_DC               : HDC;
                        X_Location         ,
                        Y_Location         ,
                        Destination_Width ,
                        Destination_Height    : integer );
procedure GET_DIB_DIMENSIONS( var The_Width  ,
                                  The_Height   : Longint );

end;
{**************************************************************************}
{                                                                          }
{                        IMPLEMENTATION SECTION                            }
{                                                                          }
{**************************************************************************}

implementation

{--------------------------------------------------------------------------}
{  _AHINCR Function                                                        }
{                                                                          }
{  This is a "magic" function; defining it causes 3.0 to patch the value   }
{  into the passed reference.  This makes it a peculiar type of global     }
{  variable. To use the value of AHINCR, use OFS( AHINCR ).                }
{--------------------------------------------------------------------------}

procedure AHIncr; FAR; EXTERNAL 'KERNEL' INDEX 114;

{--------------------------------------------------------------------------}
{ INIT Method                                                              }
{                                                                          }
{ This method initializes the DIB by setting the handle to 0, storing the  }
{ input filename, and calling the LOAD_BITMAP_FILE method.                 }
{--------------------------------------------------------------------------}

constructor File_Bitmap.INIT( The_DIB_Name : PChar );

begin

Bitmap_Handle := 0;
The_Name := The_DIB_Name;
LOAD_BITMAP_FILE;

end;

{--------------------------------------------------------------------------}
{ DONE Method                                                              }
{                                                                          }
{ This method deallocates any memory given to the DIB.                     }
{--------------------------------------------------------------------------}

destructor File_Bitmap.DONE;

begin

if Bitmap_Handle <> 0 then DELETEOBJECT( Bitmap_Handle );

end;

{--------------------------------------------------------------------------}
{ GET_BITMAP_DATA Method                                                   }
{                                                                          }
{ This method copies the bitmap bits data from the file into memory. Since }
{ copying cannot cross a segment (64K) boundary, segment arithmetic must   }
{ be done on the fly.  A LongType type was created to simplify this process}
{--------------------------------------------------------------------------}

procedure File_Bitmap.GET_BITMAP_DATA;

type

LongType = record

case Word of
0: ( Ptr  : Pointer );
1: ( Long : Longint );
2: ( Lo   : Word;
Hi   : Word    );

end;

var

Count   : Longint;
Start,
ToAddr,
Bits    : LongType;
begin

Start.Long := 0;
Bits.Ptr := GLOBALLOCK( Bits_Handle );
Count := Bits_Byte_Size - Start.Long;
while Count > 0 do
begin
ToAddr.Hi := Bits.Hi + ( Start.Hi * OFS( AHIncr ));
ToAddr.Lo := Start.Lo;
if Count > $4000 then Count := $4000;
BLOCKREAD( The_File , ToAddr.Ptr^ , Count );
Start.Long := Start.Long + Count;
Count := Bits_Byte_Size - Start.Long;
end;
GLOBALUNLOCK( Bits_Handle );
end;

{--------------------------------------------------------------------------}
{ LOAD_BITMAP_FILE Method                                                  }
{                                                                          }
{ This method is called to actually load the DIB into Windows 3.0. It sets }
{ Error_status 0 if no problems, -1 if no file found, and -2 if not a DIB. }
{--------------------------------------------------------------------------}

function File_Bitmap.LOAD_BITMAP_FILE : Boolean;
var
Test_Win30_Bitmap : Longint;
Memory_DC         : HDC;
The_IO_Result     : Word;
begin
Error_Status := 0;
LOAD_BITMAP_FILE := false;
ASSIGN( The_File , The_Name );
{$I-}
RESET( The_File , 1 );
SEEK( The_File , 14 );
BLOCKREAD( The_File , Test_Win30_Bitmap , SIZEOF( Test_Win30_Bitmap ));
{$I+}
The_IO_Result := IOResult;
If The_IO_Result <> 0 then
begin
Error_Status := -1;
The_Global_Error_Code := The_IO_Result;
end
else
begin
if Test_Win30_Bitmap = 40 then
begin
if OPEN_DIB then
begin
LOAD_BITMAP_FILE := true;
end;
end
else Error_Status := -2;
CLOSE( The_File );
end;

end;

{--------------------------------------------------------------------------}
{ OPEN_DIB Method                                                          }
{                                                                          }
{ This method does the grunt work of decoding the DIB file and obtaining   }
{ a bitmap handle from memory and storing the bitmap in it. If the format  }
{ is incorrect (more than 8 bits per color value) error code -3 is set; if }
{ memory is not available for the DIB error code -4 is set.                }
{--------------------------------------------------------------------------}

function File_Bitmap.OPEN_DIB : Boolean;

var

Bit_Count         : Word;
Size              : Word;
Long_Width        : Longint;
DC_Handle         : HDC;
Bits_Ptr          : Pointer;
Bitmap_Info       : PBitmapInfo;
New_Bitmap_Handle : THandle;
New_Pixel_Width,
New_Pixel_Height  : Word;

begin

OPEN_DIB := true;
SEEK( The_File , 28 );
BLOCKREAD( The_File , Bit_Count , SIZEOF( Bit_Count ));
if Bit_Count <= 8 then
begin
Size := SIZEOF( TBitmapInfoHeader ) + (( 1 SHL Bit_Count )
* SIZEOF( TRGBQuad ));
Bitmap_Info := MEMALLOC( Size );
SEEK( The_File , SIZEOF( TBitmapFileHeader ));
BLOCKREAD( The_File , Bitmap_Info^ , Size );
New_Pixel_Width := Bitmap_Info^.bmiHeader.biWidth;
New_Pixel_Height := Bitmap_Info^.bmiHeader.biHeight;
Long_Width := ((( New_Pixel_Width * Bit_Count ) + 31 ) div 32 ) * 4;
Bitmap_Info^.bmiHeader.biSizeImage := Long_Width * New_Pixel_Height;
GLOBALCOMPACT( -1 );
Bits_Handle := GLOBALALLOC( gmem_Moveable or gmem_Zeroinit ,
Bitmap_Info^.bmiHeader.biSizeImage );
Bits_Byte_Size := Bitmap_Info^.bmiHeader.biSizeImage;
GET_BITMAP_DATA;
DC_Handle := CREATEDC( 'Display' , nil , nil , nil );
Bits_Ptr := GLOBALLOCK( Bits_Handle );
New_Bitmap_Handle :=
CREATEDIBITMAP( DC_Handle , Bitmap_Info^.bmiHeader ,
cbm_Init , Bits_Ptr , Bitmap_Info^ , 0 );
DELETEDC( DC_Handle );
GLOBALUNLOCK( Bits_Handle );
GLOBALFREE( Bits_Handle );
FREEMEM( Bitmap_Info , Size );
if New_Bitmap_Handle <> 0 then
begin
if Bitmap_Handle <> 0 then DELETEOBJECT( Bitmap_Handle );
Bitmap_Handle := New_Bitmap_Handle;
Width := New_Pixel_Width;
Height := New_Pixel_Height;
end
else
begin
OPEN_DIB := false;
Error_Status := -4;
end;
end
else
begin
OPEN_DIB := false;
Error_Status := -3;
end;

end;

{--------------------------------------------------------------------------}
{ GET_ERROR_STATUS Method                                                  }
{                                                                          }
{ This function returns the value of the Error_Status flag; it will be     }
{ called by higher-level routines to check if INIT or CHANGE was successful}
{--------------------------------------------------------------------------}

function File_Bitmap.GET_ERROR_STATUS : Integer;

begin

GET_ERROR_STATUS := Error_Status;

end;

{--------------------------------------------------------------------------}
{ GET_FILE_NAME Method                                                     }
{                                                                          }
{ This function returns the current name and path of the DIB file. It is   }
{ used for error checking to verify the correct path has been used.        }
{--------------------------------------------------------------------------}

function File_Bitmap.GET_FILE_NAME : PChar;

begin

GET_FILE_NAME := The_Name;

end;

{--------------------------------------------------------------------------}
{ GET_DIB_DIMENSIONS Method                                                }
{                                                                          }
{ This procedure is used to obtain the pixel dimensions of the DIB; it is  }
{ used by higher-level constructs to correctly size themselves.            }
{--------------------------------------------------------------------------}

procedure File_Bitmap.GET_DIB_DIMENSIONS( var The_Width ,
The_Height  : Longint );

begin

The_Width := Width;
The_Height := Height;

end;

{--------------------------------------------------------------------------}
{ DRAW Method                                                              }
{                                                                          }
{ This method handles the grunt level work of drawing the DIB in the DC at }
{ the specified coordinates. If the bitmap handle is zero it reloads DIB.  }
{--------------------------------------------------------------------------}

procedure File_Bitmap.DRAW( The_DC      : HDC;
X_Location,
Y_Location  : integer );

var

Memory_DC : HDC;

begin

if Bitmap_Handle <> 0 then
begin
Memory_DC := CREATECOMPATIBLEDC( The_DC );
SELECTOBJECT( Memory_DC , Bitmap_Handle );
BITBLT( The_DC , X_Location , Y_Location , Width ,
Height , Memory_DC , 0 , 0 , SRCCopy );
DELETEDC( Memory_DC );
end
else
begin
if LOAD_BITMAP_FILE then
begin
Memory_DC := CREATECOMPATIBLEDC( The_DC );
SELECTOBJECT( Memory_DC , Bitmap_Handle );
BITBLT( The_DC , X_Location , Y_Location , Width ,
Height , Memory_DC , 0 , 0 , SRCCopy );
DELETEDC( Memory_DC );
end;
end;

end;

{--------------------------------------------------------------------------}
{ DRAW_RESIZED Method                                                      }
{                                                                          }
{ This method handles the grunt level work of drawing the DIB in the DC at }
{ the specified coordinates. If the bitmap handle is zero it reloads DIB.  }
{ It takes two extra parameters, Destination_Width and Destination_Height  }
{ which determine the final size of the drawn bitmap.                      }
{--------------------------------------------------------------------------}
procedure File_Bitmap.DRAW_RESIZED( The_DC               : HDC;
X_Location         ,
Y_Location         ,
Destination_Width ,
Destination_Height    : integer );

var

Memory_DC : HDC;

begin

if Bitmap_Handle <> 0 then
begin
Memory_DC := CREATECOMPATIBLEDC( The_DC );
SELECTOBJECT( Memory_DC , Bitmap_Handle );
SETSTRETCHBLTMODE( The_DC , {STRETCH_DELETESCANS} 3 );
STRETCHBLT( The_DC             ,
X_Location         ,
Y_Location         ,
Destination_Width  ,
Destination_Height ,
Memory_DC          ,
0                  ,
0                  ,
Width              ,
Height             ,
SRCCopy              );
DELETEDC( Memory_DC );
end
else
begin
if LOAD_BITMAP_FILE then
begin
Memory_DC := CREATECOMPATIBLEDC( The_DC );
SELECTOBJECT( Memory_DC , Bitmap_Handle );
SETSTRETCHBLTMODE( The_DC , {STRETCH_DELETESCANS} 3 );
STRETCHBLT( The_DC             ,
X_Location         ,
Y_Location         ,
Destination_Width  ,
Destination_Height ,
Memory_DC          ,
0                  ,
0                  ,
Width              ,
Height             ,
SRCCopy              );
DELETEDC( Memory_DC );
end;
end;
end;

{--------------------------------------------------------------------------}
{ GET_BITMAP Method                                                        }
{                                                                          }
{ This method obtains a bitmap for the DIB from the Bitmap_handle field.   }
{ It is used by higher-level constructs for obscure purposes.              }
{--------------------------------------------------------------------------}
function File_Bitmap.GET_BITMAP : HBitmap;
begin
if Bitmap_Handle = 0 then
begin
if LOAD_BITMAP_FILE then
GET_BITMAP := Bitmap_Handle
else GET_BITMAP := 0;
end
else GET_BITMAP := Bitmap_Handle;
end;

{--------------------------------------------------------------------------}
{ GET_BITMAP_NAME Method                                                   }
{                                                                          }
{ This method obtains a DIB's filename and path from the The_Name field.   }
{ It is used by higher-level constructs for obscure purposes.              }
{--------------------------------------------------------------------------}
function File_Bitmap.GET_BITMAP_NAME : PChar;
begin
GET_BITMAP_NAME := The_Name;
end;
{**************************************************************************}
{                                                                          }
{                           INITIALIZATION SECTION                         }
{                                                                          }
{**************************************************************************}

{<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><}
{                                                                         }
{  No initialization section for this unit.                               }
{                                                                         }
{<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><}
end.